home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / SORTSECT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  4KB  |  155 lines
  1. PROGRAM SortSections;
  2.  
  3. {$M 20000,0,655000}
  4.  
  5. Uses PbMISC, PbDATA, PbOBJS, PbHIGH, PbOUT0, PbPARMS;
  6.  
  7. {
  8. Description : Sorts a TEXT file by sections
  9.  
  10. Author      : Howard Richoux
  11. Date        : 1/6/94
  12. Last revised: 2/18/94 hnr 1.02 new libraries
  13. Application : IBM PC and compatibles, done in Turbo Pascal 7
  14. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  15. Published in: none
  16. }
  17.  
  18.  
  19. var ndx : HOLD_object;
  20.  
  21. var secttag   : string;        { default '\SECTION' }
  22.     sectname  : string;        { default ''  }
  23.     sectpos   : longint;       { default 0   }
  24.     sectcount : integer;       { default 0   }
  25.     sectmax   : integer;       { default 1000}
  26.  
  27.     SortToFileflag : boolean;  { default false }
  28.  
  29. {*****************************************************************}
  30.  
  31.  
  32. Procedure WriteIt(s : string);
  33.      begin
  34.      OUT(s);
  35.      end;
  36.  
  37.  
  38. Function SameFileROOT(fn1,fn2 : string) : boolean;
  39.      begin
  40.      SameFileROOT := false;
  41.      if UpCaseStr(FileRootStr(fn1)) =
  42.         UpCaseStr(FileRootStr(fn2)) then SameFileROOT := true;
  43.      end;
  44.  
  45.  
  46. Procedure GoOn;
  47. var i       : integer;
  48.     ok      : boolean;
  49.     fnbak   : string;
  50.      begin
  51.      if not FileExists(pCurrFName) then
  52.           begin
  53.           writeln('Input file NOT FOUND. [',pCurrFName,']');
  54.           exit;
  55.           end;
  56.      fnbak := pCurrFName;  forceext(fnbak,'BAK');
  57.      if SortToFileflag and FileExists(fnbak) then
  58.           begin
  59.           writeln('Backup file already exists, please erase first. [',fnbak,']');
  60.           exit;
  61.           end;
  62.  
  63.      ndx.init(sectmax);
  64.  
  65.      CreateTEXTSectionIndex(pCurrFName,secttag,ndx);
  66.      ndx.sort;
  67.      sectcount := ndx.count;
  68.      if sectcount < 2 then
  69.           begin
  70.           writeln('Input file has NONE or 1 sections. Using SECTTAG =[',secttag,']');
  71.           exit;
  72.           end
  73.      else if sectcount = sectmax then
  74.           begin
  75.           writeln('Input file has TOO MANY sections. Using SECTMAX =[',sectmax,']');
  76.           exit;
  77.           end;
  78.      writeln('  found  ',sectcount,' sections.');
  79.      ReadTEXTSection(pCurrFName,secttag,'',0,writeit);  {do whats in front}
  80.      writeln('  copied lines prior to first section.');
  81.      if pCount < sectcount then sectcount := pCount;    {for testing mainly}
  82.      for i := 1 to sectcount do
  83.           begin
  84.           ok := ndx.fetchN(i,sectname,sectpos);
  85.           ReadTEXTSection(pCurrFName,secttag,sectname,sectpos,writeit);
  86.           writeln('  copied ',i,'  ', sectname);
  87.           end;
  88.      OUTdone;
  89.      writeln('Copied ',sectcount,' sections.');
  90.      if SortToFileflag then
  91.           begin
  92.           writeln('Renaming ',pcurrfname,'   to ',fnbak);
  93.           ok := ForceRenameToBak(pCurrFName);
  94.           if ok then
  95.                begin
  96.                writeln('Renaming ',pOUTfile,'   to ',pcurrfname);
  97.                ok := ForceRenameFile(pOUTFile,pCurrFName);
  98.                if ok then
  99.                     begin
  100.                     writeln('Your original file is now named [',fnbak,']');
  101.                     writeln('The   SORTED  file is now named [',pCurrFName,']');
  102.                     end
  103.                else writeln('Renaming problem. ',pOUTfile);
  104.                end
  105.           else writeln('Renaming problem.',pCurrFName);
  106.           end;
  107.      ndx.done;
  108.      end;
  109.  
  110.  
  111.  
  112. Procedure Init;
  113. var s : string;
  114.      begin
  115.      SortToFileflag := false;
  116.      sectname  := '';
  117.      sectpos   := 0;
  118.      sectcount := 0;
  119.  
  120.      pCurrFName := '';
  121.      pOutFile   := '';
  122.      if paramcount > 0 then
  123.           begin
  124.           pCurrFName := UpCaseStr(paramstr(1));
  125.           SuggestExt(pCurrFName,'txt');
  126.           pOutFile := pCurrFName;
  127.           ForceExt(pOutFile,'NEW');
  128.           AddParm(1,'OUT',pOutFile);
  129.           end;
  130.  
  131.      AddParm(1,'SECTTAG','{SECTION');
  132.      AddParm(1,'SECTMAX','1000');
  133.      StandardOUTInit;
  134.      secttag   := GetParmStr('SECTTAG');
  135.      sectmax   := GetParmNum('SECTMAX');
  136.  
  137.      SortToFileflag := SameFileROOT(pCurrFName, pOUTFile);
  138.      end;
  139.  
  140.  
  141. (*  Main program *)
  142.     BEGIN
  143.     pProgID := 'SORTSECT 1.02';
  144.     Init;
  145.  
  146.     writeln('Sorting from ',pcurrfname,'   to ',poutfile);
  147.     if pCurrFName <> '' then
  148.          begin
  149.          GoOn;
  150.          end
  151.     else ShowDocFile;
  152.     end.
  153.  
  154.  
  155.